﻿Namespace Imaging.HDRfiles

    Public Class RadianceHDR_Read_Error
        Inherits Exception

        ''' <summary>Init a new instance</summary>
        ''' <param name="message">The message that describes the error.</param>
        Public Sub New(ByVal message As String)
            MyBase.New(message)
        End Sub
    End Class

    Public Class RadianceHDR_Write_Error
        Inherits Exception

        ''' <summary>Init a new instance</summary>
        ''' <param name="message">The message that describes the error.</param>
        Public Sub New(ByVal message As String)
            MyBase.New(message)
        End Sub
    End Class

    Public Class RadianceHDR_Format_Error
        Inherits Exception

        ''' <summary>Init a new instance</summary>
        ''' <param name="message">The message that describes the error.</param>
        Public Sub New(ByVal message As String)
            MyBase.New(message)
        End Sub
    End Class

    Public Class RadianceHDR_Memory_Error
        Inherits Exception

        ''' <summary>Init a new instance</summary>
        ''' <param name="message">The message that describes the error.</param>
        Public Sub New(ByVal message As String)
            MyBase.New(message)
        End Sub
    End Class

    ''' <summary>Supported file formats of Radiance HDR bitmaps.</summary>
    ''' <remarks></remarks>
    Public Enum RadianceHDR_Format
        unknown = -1
        RGBE_32Bit_RLE = 0
        XYZE_32Bit_RLE = 1
    End Enum

    ''' <summary>The order of the scanlines in Radiance RGBE file relative to the standard coordinates system (origin in lower left corner.</summary>
    ''' <remarks>
    ''' The values of the enumeration comfort to a bitmap mask where
    ''' <list type="table">
    ''' <listheader><item><term>Bit</term><description>Defines</description></item></listheader>
    ''' <item><term>1</term><description>The pixel order is Y/X if bit is set and X/Y if not.</description></item>
    ''' <item><term>2</term><description>The Y direction is Top-Down if bit is set and Bottom-Up if not.</description></item>
    ''' <item><term>3</term><description>The X direction Left-Right if bit is set and Right-Left if not.</description></item>
    ''' </list>
    ''' </remarks>
    Public Enum Radiance_Orientation
        ''' <summary>-Y n / +X m</summary><remarks>Bitmask: 0000 0111 (&amp;H7)</remarks>
        Y_TopDown_X_LeftRight = 1 Or 2 Or 4
        ''' <summary>-Y n / -X m</summary><remarks>Bitmask: 0000 0011(&amp;H3)</remarks>
        Y_TopDown_X_RightLeft = 1 Or 2
        ''' <summary>+Y n / -X m</summary><remarks>Bitmask: 0000 0001(&amp;H1)</remarks>
        Y_BottomUp_X_RightLeft = 1
        ''' <summary>+Y n / +X m</summary><remarks>Bitmask: 0000 0101(&amp;H5)</remarks>
        Y_BottomUp_X_LeftRight = 1 Or 4
        ''' <summary>+X m / +Y n</summary><remarks>Bitmask: 0000 0100(&amp;H4)</remarks>
        X_LeftRight_Y_BottomUp = 4
        ''' <summary>-X m / +Y n</summary><remarks>Bitmask: 0000 0000(&amp;H0)</remarks>
        X_RightLeft_Y_BottomUp = 0
        ''' <summary>-X m / -Y n</summary><remarks>Bitmask: 0000 0010(&amp;H2)</remarks>
        X_RightLeft_Y_TopDown = 2
        ''' <summary>+X m / -Y n</summary><remarks>Bitmask: 0000 0110(&amp;H6)</remarks>
        X_LeftRight_Y_TopDown = 2 Or 4
    End Enum

    Public Enum RadianceHDR_Image_ProgressType
        Reading
        Writing
        Started
        Finished
    End Enum

    Public Class RadianceHDR_Image_ProgressInfo
        Private _Percentage As Double
        Private _ProgressType As RadianceHDR_Image_ProgressType

        Public Sub New()
            Me.New(0, RadianceHDR_Image_ProgressType.Started)
        End Sub

        Public Sub New(ByVal Type As RadianceHDR_Image_ProgressType)
            Me.New(0, Type)
        End Sub

        Public Sub New(ByVal p As Double, ByVal Type As RadianceHDR_Image_ProgressType)
            _Percentage = p
            _ProgressType = Type
        End Sub

        Public ReadOnly Property Percentage() As Double
            Get
                Return _Percentage
            End Get
        End Property

        Public ReadOnly Property ProgressType() As RadianceHDR_Image_ProgressType
            Get
                Return _ProgressType
            End Get
        End Property
    End Class

    Public Class RadianceHDR_Image

        Private Const _MagicNumber = "#?"
        Private Const _DefaultProgId = "RADIANCE"
        Private Const _DefaultGamma = 2.2
        Private Const _DefaultExposure = 1.0
        Private Const _NewLine As Byte = &HA
        Private Const _RGBE_32Bit_RLE_FormatString = "32-bit_rle_rgbe"
        Private Const _XYZE_32Bit_RLE_FormatString = "32-bit_rle_xyze"
        Private Const _FormatString = "FORMAT="
        Private Const _GammaString = "GAMMA="
        Private Const _ExposureString = "EXPOSURE="

        Public Event Progress(ByVal info As RadianceHDR_Image_ProgressInfo)



        Dim _Bitmap As HDRBitmap
        Dim _FileID As String
        Dim _HeaderInfo As New List(Of String)
        Dim _Exposure As Double = _DefaultExposure
        Dim _Gamma As Double = _DefaultGamma
        Dim _Format As RadianceHDR_Format = RadianceHDR_Format.unknown
        Dim _Orientation As Radiance_Orientation


        Public Sub New(ByVal FileName As String)
            Dim f As New IO.FileStream(FileName, IO.FileMode.Open, IO.FileAccess.Read)
            Open(f)
            f.Close()
        End Sub

        Public Sub New(ByVal f As IO.Stream)
            Open(f)
        End Sub

        Public Sub New(ByVal HDRbmp As HDRBitmap)

        End Sub

        ''' <summary>
        ''' 
        ''' </summary>
        ''' <param name="f"></param>
        ''' <remarks></remarks>
        ''' <exception cref="RadianceHDR_Read_Error"/>
        ''' <exception cref="RadianceHDR_Format_Error"/>
        ''' <exception cref="RadianceHDR_Memory_Error"/>
        Public Sub Open(ByVal f As IO.Stream)

            RaiseEvent Progress(New RadianceHDR_Image_ProgressInfo(0, RadianceHDR_Image_ProgressType.Started))

            ReadHeader(f)
            InitBitmap(f)

            Dim x As Integer
            Dim y As Integer

            Dim MinX As Integer
            Dim MaxX As Integer
            Dim Xstep As Integer

            Dim MinY As Integer
            Dim MaxY As Integer
            Dim Ystep As Integer

            If (_Orientation And 3) = 1 Then
                MinX = _Bitmap.Width - 1 : MaxX = 0 : Xstep = -1
            Else
                MinX = 0 : MaxX = _Bitmap.Width - 1 : Xstep = 1
            End If

            If (_Orientation And 2) = 1 Then
                MinY = _Bitmap.Height - 1 : MaxY = 0 : Ystep = -1
            Else
                MinY = 0 : MaxY = _Bitmap.Height - 1 : Ystep = 1
            End If

            If (_Orientation And 1) = 0 Then _
                Throw New RadianceHDR_Format_Error(String.Format("Rotated images are not supported (X/Y-order of scanlines found, Y/X expected)."))

            For y = MinY To MaxY Step Ystep
                ReadLineRLE(f, y, MinX, MaxX, Xstep)
                RaiseEvent Progress(New RadianceHDR_Image_ProgressInfo((y * Ystep) / Math.Abs(MinY - MaxY), RadianceHDR_Image_ProgressType.Reading))
            Next

            RaiseEvent Progress(New RadianceHDR_Image_ProgressInfo(0, RadianceHDR_Image_ProgressType.Finished))


            'If _Format = HDR_Format.XYZE_32Bit_RLE Then

            'End If
        End Sub

        Public Sub Save(ByVal FileName As String)
            Dim f As New IO.FileStream(FileName, IO.FileMode.Create, IO.FileAccess.Write)
            Save(f)
            f.Close()
        End Sub

        Public Sub Save(ByVal f As IO.Stream)
            RaiseEvent Progress(New RadianceHDR_Image_ProgressInfo(0, RadianceHDR_Image_ProgressType.Started))
            WriteHeader(f)
            For y = 0 To _Bitmap.Height - 1
                WriteLineRLE(f, y, 0, _Bitmap.Width - 1, 1)
                RaiseEvent Progress(New RadianceHDR_Image_ProgressInfo(y / _Bitmap.Height, RadianceHDR_Image_ProgressType.Writing))
            Next
            RaiseEvent Progress(New RadianceHDR_Image_ProgressInfo(0, RadianceHDR_Image_ProgressType.Finished))
        End Sub

        ''' <summary>Help method for <see cref="ReadHeader"/> to extract one line from file header.</summary>
        ''' <param name="f"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Private Function ReadHeaderLine(ByVal f As IO.Stream) As String
            Dim tmpStr As String = ""
            Dim b As Byte = f.ReadByte

            Do While b >= 0 AndAlso b <> _NewLine
                tmpStr &= Chr(b)
                b = f.ReadByte
            Loop
            Return tmpStr
        End Function

        ''' <summary>Initialises the <see cref="_Bitmap">bitmap buffer</see> and read parameter (<see cref="_Orientation"/>) by evaluating the resolution string from file header.</summary>
        ''' <param name="f">The stream to read from.</param>
        ''' <remarks></remarks>
        ''' <exception cref="RadianceHDR_Read_Error"/>
        ''' <exception cref="RadianceHDR_Format_Error">Will be thrown if resolution string is not in the expected format.</exception>>
        Private Sub InitBitmap(ByVal f As IO.Stream)
            Dim RegExpString As New System.Text.RegularExpressions.Regex("(([\+|-]Y) ([0-9]+) ([\+|-]X) ([0-9]+))|(([\+|-]X) ([0-9]+) ([\+|-]Y) ([0-9]+))")
            Dim tmpStr As String = ReadHeaderLine(f)
            Dim RegExpMatches As System.Text.RegularExpressions.MatchCollection = RegExpString.Matches(tmpStr)

            Dim token(0 To 3) As String
            Dim i As Integer = 0
            Dim _width As Integer
            Dim _height As Integer

            If RegExpMatches.Count = 1 Then
                For Each item As System.Text.RegularExpressions.Group In RegExpMatches(0).Groups
                    If (Not String.IsNullOrEmpty(item.Value)) AndAlso Not (tmpStr.Equals(item.Value)) Then
                        token(i) = item.Value
                        i += 1
                    End If
                Next

                _Orientation = 0
                If token(0).Substring(1) = "Y" Then
                    _Orientation += 1 'Y/X
                    If token(0).StartsWith("-") Then _Orientation += 2 '-Y
                    If token(2).StartsWith("+") Then _Orientation += 4 '+X

                    If (Not Integer.TryParse(token(1), _height)) Then _
                        Throw New RadianceHDR_Format_Error(String.Format("Invalid Radiance RGBE file ('{0}' is an invalid image height).", token(1)))
                    If (Not Integer.TryParse(token(3), _width)) Then _
                        Throw New RadianceHDR_Format_Error(String.Format("Invalid Radiance RGBE file ('{0}' is an invalid image width).", token(3)))

                Else 'X/Y
                    If token(0).StartsWith("+") Then _Orientation += 2 '+X
                    If token(2).StartsWith("-") Then _Orientation += 4 '-Y
                    If (Not Integer.TryParse(token(1), _width)) Then _
                        Throw New RadianceHDR_Format_Error(String.Format("Invalid Radiance RGBE file ('{0}' is an invalid image width).", token(1)))
                    If (Not Integer.TryParse(token(3), _height)) Then _
                        Throw New RadianceHDR_Format_Error(String.Format("Invalid Radiance RGBE file ('{0}' is an invalid image height).", token(3)))

                End If

                _Bitmap = New HDRBitmap(_width, _height)

            Else
                Throw New RadianceHDR_Format_Error(String.Format("Invalid Radiance RGBE file ('{0}' is an invalid resolution string).", tmpStr))
            End If


        End Sub

        ''' <summary>Help method to read the header information from RGBE file.</summary>
        ''' <param name="f">The stream to read from.</param>
        ''' <remarks>
        ''' The method will set <see cref="_Exposure"/>, <see cref="_Gamma"/>, <see cref="_Format"/> 
        ''' and will fill <see cref="_HeaderInfo"/> with additional info.</remarks>
        ''' <exception cref="RadianceHDR_Read_Error"/>
        ''' <exception cref="RadianceHDR_Format_Error"/>
        Private Sub ReadHeader(ByVal f As IO.Stream)
            If Not f.CanRead Then Throw New RadianceHDR_Read_Error("Unable to read from stream.")

            Dim tmpStr As String = ReadHeaderLine(f)
            If tmpStr.StartsWith(_MagicNumber) Then
                _FileID = tmpStr

                tmpStr = ReadHeaderLine(f)
                Do While tmpStr <> ""
                    _HeaderInfo.Add(tmpStr)

                    If tmpStr.StartsWith(_ExposureString) Then
                        Double.TryParse(tmpStr.Substring(_ExposureString.Length), _Exposure)
                    ElseIf tmpStr.StartsWith(_FormatString) Then
                        If tmpStr.IndexOf(_RGBE_32Bit_RLE_FormatString, _FormatString.Length) >= 0 Then
                            _Format = RadianceHDR_Format.RGBE_32Bit_RLE
                        ElseIf tmpStr.IndexOf(_XYZE_32Bit_RLE_FormatString, _FormatString.Length) >= 0 Then
                            _Format = RadianceHDR_Format.XYZE_32Bit_RLE
                        Else
                            Throw New RadianceHDR_Format_Error(String.Format("Unknown format '{0}'.", tmpStr))
                        End If
                    ElseIf tmpStr.StartsWith(_GammaString) Then
                        Double.TryParse(tmpStr.Substring(_GammaString.Length), _Gamma)
                    End If

                    tmpStr = ReadHeaderLine(f)
                Loop

                If _Format = RadianceHDR_Format.unknown Then _
                     Throw New RadianceHDR_Format_Error(String.Format("Invalid Radiance RGBE file (no format defined).", tmpStr, _MagicNumber))

            Else
                Throw New RadianceHDR_Format_Error(String.Format("Invalid Radiance RGBE file ('{0}' does not start with expected magic number '{1}').", tmpStr, _MagicNumber))
            End If
        End Sub

        Private Sub ReadLine(ByVal f As IO.Stream, ByVal CurrentY As Integer, ByVal MinX As Integer, ByVal MaxX As Integer, ByVal Xstep As Integer)
            Dim RGBE_buf(0 To 3) As Byte
            For X As Integer = MinX To MaxX Step Xstep
                If f.Read(RGBE_buf, 0, 4) < 4 Then _
                    Throw New RadianceHDR_Read_Error(String.Format("Error while reading line {0}", CurrentY))

                _Bitmap.PixelAsRGB(X, CurrentY) = Imaging.ColorSpaceConverter.RGBE2RGB(RGBE_buf(0), RGBE_buf(1), RGBE_buf(2), RGBE_buf(3))
            Next

        End Sub

        Private Sub ReadLineRLE(ByVal f As IO.Stream, ByVal CurrentY As Integer, ByVal MinX As Integer, ByVal MaxX As Integer, ByVal Xstep As Integer)
            Dim scanline_width As Integer = Math.Abs(MaxX - MinX) + 1
            Dim RGBE_buf(0 To 3) As Byte


            'run length encoding is not allowed so read flat
            If (scanline_width < 8) OrElse (scanline_width > &H7FFF) Then
                ReadLine(f, CurrentY, MinX, MaxX, Xstep)
            Else
                If f.Read(RGBE_buf, 0, 4) < 4 Then _
                    Throw New RadianceHDR_Read_Error(String.Format("Error while reading line {0}", CurrentY))

                If RGBE_buf(0) <> 2 OrElse RGBE_buf(1) <> 2 OrElse (RGBE_buf(2) And &H80) Then
                    'this file is not run length encoded
                    _Bitmap.PixelAsRGB(MinX, CurrentY) = Imaging.ColorSpaceConverter.RGBE2RGB(RGBE_buf(0), RGBE_buf(1), RGBE_buf(2), RGBE_buf(3))
                    ReadLine(f, CurrentY, MinX + Xstep, MaxX, Xstep)
                Else
                    If ((CInt(RGBE_buf(2)) << 8) Or CInt(RGBE_buf(3))) <> scanline_width Then _
                        Throw New RadianceHDR_Format_Error(String.Format("Wrong scanline width '{0}' ('{1}' expected)", (CInt(RGBE_buf(2)) << 8) Or CInt(RGBE_buf(3)), scanline_width))

                    Dim scanline_buffer(0 To 3, 0 To scanline_width - 1) As Byte
                    Dim CurrentX As Integer
                    Dim count As Integer
                    'read each of the four channels for the scanline into the buffer
                    For i As Integer = 0 To 3
                        CurrentX = 0
                        Do While (CurrentX < scanline_width)
                            If f.Read(RGBE_buf, 0, 2) < 2 Then _
                                Throw New RadianceHDR_Read_Error(String.Format("Error while reading line {0}", CurrentY))

                            If RGBE_buf(0) > 128 Then
                                count = RGBE_buf(0) - 128
                                If (count = 0) OrElse (count > scanline_width - CurrentX) Then _
                                    Throw New RadianceHDR_Format_Error(String.Format("Bad scanline data in line '{0}'", CurrentY))

                                For Ofs As Integer = 0 To count - 1
                                    scanline_buffer(i, CurrentX + Ofs) = RGBE_buf(1)
                                Next

                            Else
                                'a non-run
                                count = RGBE_buf(0)
                                If (count = 0) OrElse (count > scanline_width - CurrentX) Then _
                                    Throw New RadianceHDR_Format_Error(String.Format("Bad scanline data in line '{0}'", CurrentY))

                                scanline_buffer(i, CurrentX) = RGBE_buf(1)

                                For Ofs As Integer = 1 To count - 1
                                    scanline_buffer(i, CurrentX + Ofs) = f.ReadByte()
                                Next

                            End If
                            CurrentX += count

                        Loop
                    Next


                    'now convert data from buffer into floats
                    For X As Integer = MinX To MaxX Step Xstep
                        _Bitmap.PixelAsRGB(X, CurrentY) = Imaging.ColorSpaceConverter.RGBE2RGB(scanline_buffer(0, X), _
                                                                                               scanline_buffer(1, X), _
                                                                                               scanline_buffer(2, X), _
                                                                                               scanline_buffer(3, X))
                    Next
                End If
            End If


        End Sub

        Private Sub WriteHeader(ByVal f As IO.Stream)
            If Not f.CanWrite Then Throw New RadianceHDR_Write_Error("Unable to write to stream.")

            ' The #? is to identify file type, the programtype is optional.
            Dim tmpStr As String
            If Not String.IsNullOrEmpty(_FileID) AndAlso _FileID.StartsWith(_MagicNumber) Then
                tmpStr = _FileID
            Else
                tmpStr = _MagicNumber & _DefaultProgId
            End If
            For Each c As Char In String.Format("{0}", tmpStr)
                f.WriteByte(Asc(c))
            Next
            f.WriteByte(_NewLine)

            If _Gamma <> _DefaultGamma Then
                For Each c As Char In String.Format("{0}{1:g}", _GammaString, _Gamma)
                    f.WriteByte(Asc(c))
                Next
                f.WriteByte(_NewLine)
            End If

            If _Exposure <> _DefaultExposure Then
                For Each c As Char In String.Format("{0}{1:g}", _ExposureString, _Exposure)
                    f.WriteByte(Asc(c))
                Next
                f.WriteByte(_NewLine)
            End If

            If _Format = RadianceHDR_Format.RGBE_32Bit_RLE Then
                tmpStr = _FormatString & _RGBE_32Bit_RLE_FormatString
            Else
                tmpStr = _FormatString & _XYZE_32Bit_RLE_FormatString
            End If
            For Each c As Char In tmpStr
                f.WriteByte(Asc(c))
            Next
            f.WriteByte(_NewLine)
            f.WriteByte(_NewLine)

            For Each c As Char In String.Format("-Y {0:d} +X {1:d}", _Bitmap.Height, _Bitmap.Width)
                f.WriteByte(Asc(c))
            Next
            f.WriteByte(_NewLine)
            _Orientation = Radiance_Orientation.Y_TopDown_X_LeftRight

        End Sub

        Private Sub WriteLine(ByVal f As IO.Stream, ByVal CurrentY As Integer, ByVal MinX As Integer, ByVal MaxX As Integer, ByVal Xstep As Integer)
            Dim RGBE As Imaging.RGBEQuadlet

            For X As Integer = MinX To MaxX Step Xstep
                RGBE = Imaging.ColorSpaceConverter.RGB2RGBE(_Bitmap.PixelAsRGB(X, CurrentY))
                f.WriteByte(RGBE.Red)
                f.WriteByte(RGBE.Green)
                f.WriteByte(RGBE.Blue)
                f.WriteByte(RGBE.Exponent)
            Next

        End Sub

        Private Sub WriteLineRLE(ByVal f As IO.Stream, ByVal CurrentY As Integer, ByVal MinX As Integer, ByVal MaxX As Integer, ByVal Xstep As Integer)
            Dim scanline_width As Integer = Math.Abs(MaxX - MinX) + 1
            Dim RGBE_buf(0 To 3) As Byte
            Dim RGBE As Imaging.RGBEQuadlet

            If (scanline_width < 8) OrElse (scanline_width > &H7FFF) Then
                WriteLine(f, CurrentY, MinX, MaxX, Xstep)
            Else
                Dim buffer(0 To 3, 0 To scanline_width - 1) As Byte
                'split RGBE chanels
                For X = MinX To MaxX Step Xstep
                    RGBE = Imaging.ColorSpaceConverter.RGB2RGBE(_Bitmap.PixelAsRGB(X, CurrentY))
                    buffer(0, X) = RGBE.Red
                    buffer(1, X) = RGBE.Green
                    buffer(2, X) = RGBE.Blue
                    buffer(3, X) = RGBE.Exponent
                Next

                'write scanline mark for RLE encoded scanlines
                f.WriteByte(2)
                f.WriteByte(2)
                f.WriteByte((scanline_width >> 8) And &HFF)
                f.WriteByte(scanline_width And &HFF)


                Const MinRunLength = 4

                For i = 0 To 3
                    Dim buf(2) As Byte
                    Dim Ofs As Integer = 0


                    Dim Run_Start As Integer = 0
                    Dim Run_Count As Integer = 0
                    Dim Run_Count_Old As Integer = 0
                    Dim NonRun_Count As Integer


                    Do While Ofs < scanline_width
                        Run_Start = Ofs

                        Run_Count = 0
                        Run_Count_Old = 0

                        Do While (Run_Count < MinRunLength) AndAlso (Run_Start < scanline_width)
                            Run_Start += Run_Count
                            Run_Count_Old = Run_Count
                            Run_Count = 1
                            Do While (Run_Start + Run_Count < scanline_width) AndAlso (Run_Count < 127) AndAlso (buffer(i, Run_Start) = buffer(i, Run_Start + Run_Count))
                                Run_Count += 1
                            Loop
                        Loop

                        'if data before next big run is a short run then write it as such
                        If (Run_Count_Old > 1) AndAlso (Run_Count_Old = Run_Start - Ofs) Then
                            buf(0) = 128 + Run_Count_Old 'write short run
                            buf(1) = buffer(i, Ofs)
                            f.Write(buf, 0, 2)
                            Ofs = Run_Start
                        End If

                        'write out bytes until we reach the start of the next run
                        Do While (Ofs < Run_Start)
                            NonRun_Count = Run_Start - Ofs
                            If (NonRun_Count > 128) Then NonRun_Count = 128
                            'NonRun_Count = 128
                            f.WriteByte(NonRun_Count)
                            For j = 0 To NonRun_Count - 1
                                f.WriteByte(buffer(i, Ofs + j))
                            Next
                            Ofs += NonRun_Count
                        Loop

                        'write out next run if one was found
                        If (Run_Count >= MinRunLength) Then
                            buf(0) = 128 + Run_Count
                            buf(1) = buffer(i, Run_Start)
                            f.Write(buf, 0, 2)
                            Ofs += Run_Count
                        End If

                    Loop


                Next

            End If

        End Sub

        Public Property Image() As HDRBitmap
            Get
                Return _Bitmap
            End Get
            Set(ByVal value As HDRBitmap)
                _Bitmap = value
            End Set
        End Property

    End Class

End Namespace
